{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  OchreLang.ModuleIO
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Loading Modules...
--
--------------------------------------------------------------------------------


module OchreLang.ModuleIO
  ( 
    loadProgram
  ) where

import OchreLang.Builtin
import OchreLang.CompilerMon
import qualified OchreLang.OrchSpec as OS
import OchreLang.Parser
import OchreLang.SyntaxBase
import OchreLang.TopSyntax


import Text.Parsec.Error                        -- package: parsec


import Data.Foldable ( foldrM )
import qualified Data.Map as Map
import System.Directory
import System.FilePath
import Text.Printf


loadProgram :: FilePath -> FilePath 
            -> Compiler ([Builtin],Program)
loadProgram builts_path main_path = do 
    { builts            <- loadBuiltins builts_path
    ; main_name         <- mainName main_path
    ; (ospec, mod_main) <- loadMainModule main_path
    ; let dict          = Map.singleton (module_name mod_main) mod_main
    ; new_dict          <- loadChildModules dict mod_main
    ; let prgm          = Program { program_orch_spec = ospec
                                  , program_modules   = new_dict
                                  , program_main_name = main_name
                                  }
    ; return (builts,prgm)
    }



mainName :: FilePath -> Compiler String
mainName path = case splitFileName path of
    (_,s) | null s -> throwError "ModuleIO.mainName" 
                                 "Cannot extract main module name from path"
          | otherwise -> return $ dropExtension s


findLibraryModule :: ModuleName -> Compiler FilePath
findLibraryModule mod_name = askSearchPaths >>= step 
  where
    errK        = throwError "ModuleIO.findLibraryModule"
                             (printf "Cannot find module: %s" 
                                     (moduleNameString mod_name))

    step []     = process1 "" errK
    step (x:xs) = process1 x (step xs)

    process1 ss end = let file_name = resolveFileName ss mod_name in
                      do { ans <- liftIO $ doesFileExist file_name
                         ; if ans then return file_name else end }


-- | Module names should be the same as file names except for 
-- Main.
--
-- The Main file can have any name but the module name should 
-- be Main.
--
resolveFileName :: FilePath -> ModuleName -> FilePath
resolveFileName prefix mod_name = 
    normalise $ prefix `combine` (makeSuffix $ deconsModuleName mod_name)
  where
    makeSuffix (xs,x)    = let front = joinPath xs; back = x <.> "ochre" 
                           in front `combine` back


liftParse :: IO (Either ParseError a) -> Compiler a
liftParse parse_ans = liftIO parse_ans >>= next
  where
    next (Left err) = throwError "ModuleIO.liftParse" (show err)
    next (Right a)  = return a

loadBuiltins :: FilePath -> Compiler [Builtin]
loadBuiltins = liftParse . parseBuiltins

loadMainModule :: FilePath -> Compiler (OS.OrchSpec,Module)
loadMainModule = liftParse . parseMainModule

loadLibraryModule :: ModuleName -> Compiler Module
loadLibraryModule mod_name = findLibraryModule mod_name >>= liftParse . parseLibraryModule


loadChildModules :: ModuleDict -> Module -> Compiler ModuleDict
loadChildModules dict = foldrM fn dict . module_imports 
  where
    fn mod_name ac 
        | Map.member mod_name ac = return ac
        | otherwise              = do { a <- loadLibraryModule mod_name
                                      ; let d2 = Map.insert mod_name a dict
                                      ; loadChildModules d2 a
                                      }
